CD Ware Multimedia 1995 May

home *** CD-ROM | disk | FTP | other *** search

/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / WIN / VB_CTRLS / SPLINES.ZIP / SPLINAPP.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1993-12-04 | 18.1 KB | 575 lines

VERSION 2.00 Begin Form Form1 BackColor = &H00FFFFFF& Caption = "This is Splinal App!" ClientHeight = 6630 ClientLeft = 2745 ClientTop = 1800 ClientWidth = 5970 Height = 7095 Icon = SPLINAPP.FRX:0000 Left = 2655 LinkMode = 1 'Source LinkTopic = "Form1" ScaleHeight = 6630 ScaleWidth = 5970 Top = 1425 Width = 6150 Begin CommandButton btnAbout Caption = "&About..." Height = 435 Left = 4410 TabIndex = 27 Top = 6090 Width = 1275 End Begin CommandButton btnExit Caption = "E&xit" Height = 435 Left = 2940 TabIndex = 24 Top = 5535 Width = 1275 End Begin CommandButton btnReset Caption = "&Reset" Height = 435 Left = 4410 TabIndex = 9 Top = 5535 Width = 1275 End Begin Frame ParameterFrame BackColor = &H00FFFFFF& Caption = "Parameters" Height = 2025 Left = 2910 TabIndex = 17 Top = 3255 Width = 2775 Begin SpinButton spinBias Delay = 50 Enabled = 0 'False Height = 285 Left = 2415 Top = 1440 Width = 225 End Begin SpinButton spinTension Delay = 50 Enabled = 0 'False Height = 285 Left = 2415 Top = 1080 Width = 225 End Begin SpinButton spinResolution Delay = 50 Height = 285 Left = 2415 Top = 720 Width = 225 End Begin TextBox txtBias Enabled = 0 'False Height = 285 Left = 1680 TabIndex = 8 Top = 1440 Width = 750 End Begin TextBox txtTension Enabled = 0 'False Height = 285 Left = 1680 TabIndex = 7 Top = 1080 Width = 750 End Begin TextBox txtResolution Height = 285 Left = 1680 TabIndex = 6 Top = 720 Width = 750 End Begin Label lblNumPointsLabel Alignment = 1 'Right Justify BackColor = &H00FFFFFF& Caption = "Number of Points:" Height = 285 Left = 15 TabIndex = 23 Top = 360 Width = 1575 End Begin Label lblResolution Alignment = 1 'Right Justify BackColor = &H00FFFFFF& Caption = "Resolution:" Height = 240 Left = 15 TabIndex = 22 Top = 720 Width = 1605 End Begin Label lblTension Alignment = 1 'Right Justify BackColor = &H00FFFFFF& Caption = "Tension:" Enabled = 0 'False Height = 270 Left = 15 TabIndex = 21 Top = 1080 Width = 1575 End Begin Label lblBias Alignment = 1 'Right Justify BackColor = &H00FFFFFF& Caption = "Bias:" Enabled = 0 'False Height = 270 Left = 15 TabIndex = 20 Top = 1440 Width = 1575 End Begin Label lblNumPoints Caption = "###" Height = 285 Left = 1680 TabIndex = 19 Top = 360 Width = 960 End End Begin Frame TypeFrame BackColor = &H00FFFFFF& Caption = "Curve Type" Height = 2685 Left = 315 TabIndex = 11 Top = 3255 Width = 2535 Begin PictureBox picCurveColor Height = 255 Index = 6 Left = 1950 ScaleHeight = 225 ScaleWidth = 345 TabIndex = 18 Top = 710 Width = 375 End Begin CheckBox chkCurveType BackColor = &H00FFFFFF& Caption = "Control &Points" Height = 255 Index = 6 Left = 120 TabIndex = 4 Top = 710 Value = 1 'Checked Width = 1575 End Begin PictureBox picCurveColor Height = 255 Index = 5 Left = 1950 ScaleHeight = 225 ScaleWidth = 345 TabIndex = 16 Top = 2160 Width = 375 End Begin CommonDialog CMDialog1 Left = 1260 Top = 2100 End Begin CheckBox chkCurveType BackColor = &H00FFFFFF& Caption = "&Tau" Height = 255 Index = 5 Left = 120 TabIndex = 5 Top = 2160 Width = 1095 End Begin PictureBox picCurveColor Height = 255 Index = 4 Left = 1950 ScaleHeight = 225 ScaleWidth = 345 TabIndex = 15 Top = 1800 Width = 375 End Begin CheckBox chkCurveType BackColor = &H00FFFFFF& Caption = "B&eta" Height = 255 Index = 4 Left = 120 TabIndex = 3 Top = 1800 Width = 1215 End Begin PictureBox picCurveColor Height = 255 Index = 3 Left = 1950 ScaleHeight = 225 ScaleWidth = 345 TabIndex = 14 Top = 1440 Width = 375 End Begin CheckBox chkCurveType BackColor = &H00FFFFFF& Caption = "&Bspline" Height = 255 Index = 3 Left = 120 TabIndex = 2 Top = 1440 Width = 1215 End Begin PictureBox picCurveColor Height = 255 Index = 2 Left = 1950 ScaleHeight = 225 ScaleWidth = 345 TabIndex = 13 Top = 1080 Width = 375 End Begin CheckBox chkCurveType BackColor = &H00FFFFFF& Caption = "Be&zier" Height = 255 Index = 2 Left = 120 TabIndex = 1 Top = 1080 Width = 1215 End Begin PictureBox picCurveColor Height = 255 Index = 0 Left = 1950 ScaleHeight = 225 ScaleWidth = 345 TabIndex = 12 Top = 360 Width = 375 End Begin CheckBox chkCurveType BackColor = &H00FFFFFF& Caption = "&Control Polygon" Height = 255 Index = 0 Left = 120 TabIndex = 0 Top = 360 Value = 1 'Checked Width = 1725 End End Begin PictureBox picDisplay AutoRedraw = -1 'True Height = 2955 Left = 315 ScaleHeight = 195 ScaleMode = 3 'Pixel ScaleWidth = 357 TabIndex = 10 TabStop = 0 'False Top = 210 Width = 5385 Begin Label lblOdom Alignment = 2 'Center BorderStyle = 1 'Fixed Single Height = 225 Left = 4320 TabIndex = 25 Top = 2625 Width = 960 End End Begin Label Label1 Caption = "Click left button to add new point. Click right button to delete last point." Height = 435 Left = 210 TabIndex = 26 Top = 6165 Width = 3270 End 'Copyright (C) Andrew S. Dean 1993 Option Explicit Const idxControlPolygon = 0 Const idxHermite = 1 Const idxBezier = 2 Const idxBspline = 3 Const idxBeta = 4 Const idxTau = 5 Const idxControlPoints = 6 Const EM_AddPoint = 0 Const EM_MovePoint = 1 Const EM_DeletePoint = 2 ' Use this to determine whether left or right ' mouse button was clicked in display. Dim giButton As Integer Sub AddControlPoint (fx As Single, fy As Single, fz As Single) glNumControlPoints = glNumControlPoints + 1 ' Add the new point to the control polygon. ControlPoly(glNumControlPoints).fx = fx ControlPoly(glNumControlPoints).fy = fy ControlPoly(glNumControlPoints).fz = fz ' Update the text value. lblNumPoints.Caption = Str$(glNumControlPoints) End Sub Sub btnAbout_Click () frmAbout.Show MODAL End Sub Sub btnExit_Click () End End Sub Sub btnReset_Click () glNumControlPoints = 0 lblNumPoints.Caption = Str$(glNumControlPoints) picDisplay.Cls End Sub Sub chkCurveType_Click (Index As Integer) picDisplay.Cls DrawAllActiveCurves If (chkCurveType(idxBeta).Value = CHECKED) Then txtTension.Enabled = True txtBias.Enabled = True lblTension.Enabled = True lblBias.Enabled = True spinTension.Enabled = True spinBias.Enabled = True ElseIf (chkCurveType(idxTau).Value = CHECKED) Then txtTension.Enabled = True txtBias.Enabled = True lblTension.Enabled = True lblBias.Enabled = True spinTension.Enabled = True spinBias.Enabled = True ElseIf (chkCurveType(idxBspline).Value = CHECKED) Then txtTension.Enabled = True txtBias.Enabled = False lblTension.Enabled = True lblBias.Enabled = False spinTension.Enabled = True spinBias.Enabled = False Else txtTension.Enabled = False txtBias.Enabled = False lblTension.Enabled = False lblBias.Enabled = False spinTension.Enabled = False spinBias.Enabled = False End If End Sub Sub DeleteLastPoint () If (glNumControlPoints = 0) Then Exit Sub End If glNumControlPoints = glNumControlPoints - 1 ' Update the text value. lblNumPoints.Caption = Str$(glNumControlPoints) End Sub Sub Delta (C As TextBox, dDelta As Double) Dim dVal As Double dVal = Val(C.Text) dVal = dVal + dDelta C.Text = Format(dVal) End Sub Sub DrawAllActiveCurves () If (glNumControlPoints <= 0) Then Exit Sub End If If chkCurveType(idxControlPolygon).Value = CHECKED Then DrawControl End If If chkCurveType(idxBspline).Value = CHECKED Then DrawBspline End If If chkCurveType(idxBezier).Value = CHECKED Then DrawBezier End If If chkCurveType(idxBeta).Value = CHECKED Then DrawBeta End If If chkCurveType(idxTau).Value = CHECKED Then DrawTau End If If chkCurveType(idxControlPoints).Value = CHECKED Then DrawControlPoints End If End Sub Sub DrawBeta () Dim I As Long Dim lCurveLen As Long ' Call DLL function to compute spline points. lCurveLen = BetaSpline(glCurveResolution, gfTension, gfBias, glNumControlPoints, ControlPoly(0), Curve(0)) ' Draw the spline. picDisplay.CurrentX = Curve(0).fx picDisplay.CurrentY = Curve(0).fy For I = 1 To lCurveLen picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBeta).BackColor Next I End Sub Sub DrawBezier () Dim I As Long Dim lCurveLen As Long ' Call DLL function to compute spline points. lCurveLen = Bezier(glCurveResolution, glNumControlPoints, ControlPoly(0), Curve(0)) ' Draw the spline. picDisplay.CurrentX = Curve(0).fx picDisplay.CurrentY = Curve(0).fy For I = 1 To lCurveLen picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBezier).BackColor Next I End Sub Sub DrawBspline () Dim I As Long Dim lCurveLen As Long ' Call DLL function to compute spline points. lCurveLen = Bspline(glCurveResolution, gfTension, glNumControlPoints, ControlPoly(0), Curve(0)) ' Draw the spline. picDisplay.CurrentX = Curve(0).fx picDisplay.CurrentY = Curve(0).fy For I = 1 To lCurveLen picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxBspline).BackColor Next I End Sub Sub DrawControl () Dim I As Long picDisplay.CurrentX = ControlPoly(1).fx picDisplay.CurrentY = ControlPoly(1).fy For I = 2 To glNumControlPoints picDisplay.Line -(ControlPoly(I).fx, ControlPoly(I).fy), picCurveColor(idxControlPolygon).BackColor Next I End Sub Sub DrawControlPoints () Dim I As Long ' Display all the current control points. ' Note: Would it be better to use a shape control? ' What would be easier for moving/dragging? I ' don't think it matters much for deleting. For I = 1 To glNumControlPoints picDisplay.Circle (ControlPoly(I).fx, ControlPoly(I).fy), 3, picCurveColor(idxControlPoints).BackColor Next I End Sub Sub DrawTau () Dim I As Long Dim lCurveLen As Long ' Call DLL function to compute spline points. lCurveLen = TauSpline(glCurveResolution, gfTension, gfBias, glNumControlPoints, ControlPoly(0), Curve(0)) ' Draw the spline. picDisplay.CurrentX = Curve(0).fx picDisplay.CurrentY = Curve(0).fy For I = 1 To lCurveLen picDisplay.Line -(Curve(I).fx, Curve(I).fy), picCurveColor(idxTau).BackColor Next I End Sub Sub Form_Load () CenterForm Form1 ' Initial line colors. picCurveColor(idxControlPolygon).BackColor = RGB(255, 0, 0) picCurveColor(idxBezier).BackColor = RGB(0, 255, 0) picCurveColor(idxBspline).BackColor = RGB(0, 0, 255) picCurveColor(idxTau).BackColor = RGB(0, 255, 255) picCurveColor(idxBeta).BackColor = RGB(255, 0, 255) picCurveColor(idxControlPoints).BackColor = RGB(0, 0, 0) ' Initial parameter values. glNumControlPoints = 0 lblNumPoints.Caption = Str$(glNumControlPoints) glCurveResolution = 10 txtResolution.Text = Str$(glCurveResolution) gfTension = 1# txtTension.Text = Str$(gfTension) gfBias = 1# txtBias.Text = Str$(gfBias) End Sub Sub picCurveColor_Click (Index As Integer) CMDialog1.Color = &HFF& CMDialog1.Flags = CC_RGBINIT ' Display color dialog CMDialog1.Action = 3 ' Set the pic color picCurveColor(Index).BackColor = CMDialog1.Color picDisplay.Cls DrawAllActiveCurves End Sub Sub picDisplay_Click () If (giButton = LEFT_BUTTON) Then AddControlPoint CSng(picDisplay.CurrentX), CSng(picDisplay.CurrentY), 0# picDisplay.Cls Else DeleteLastPoint picDisplay.Cls End If DrawAllActiveCurves End Sub Sub picDisplay_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single) ' Update the Current coordinates whenever the mouse ' is down. Current* can then be used in the click. picDisplay.CurrentX = X picDisplay.CurrentY = Y ' If the right mouse button went down, set up to delete the last control ' point. This is a Q&D undo function. giButton = Button End Sub Sub picDisplay_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single) Dim szOdom As String szOdom = "(" & X & "," & Y & ")" lblOdom.Caption = szOdom End Sub Sub picDisplay_Paint () DrawAllActiveCurves End Sub Sub spinBias_SpinDown () Delta txtBias, -.1 End Sub Sub spinBias_SpinUp () Delta txtBias, .1 End Sub Sub spinResolution_SpinDown () Delta txtResolution, -1 End Sub Sub spinResolution_SpinUp () Delta txtResolution, 1 End Sub Sub spinTension_SpinDown () Delta txtTension, -.1 End Sub Sub spinTension_SpinUp () Delta txtTension, .1 End Sub Sub txtBias_Change () gfBias = Val(txtBias.Text) picDisplay.Cls DrawAllActiveCurves End Sub Sub txtResolution_Change () glCurveResolution = Val(txtResolution.Text) If (glCurveResolution <= 0) Then MsgBox "Resolution must be a positive number." Exit Sub End If picDisplay.Cls DrawAllActiveCurves End Sub Sub txtTension_Change () gfTension = Val(txtTension.Text) picDisplay.Cls DrawAllActiveCurves End Sub